home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tclUnixAZ.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-06-29  |  50.3 KB  |  2,017 lines
  1. /* 
  2.  * tclUnixAZ.c --
  3.  *
  4.  *    This file contains the top-level command procedures for
  5.  *    commands in the Tcl core that require UNIX facilities
  6.  *    such as files and process execution.  Much of the code
  7.  *    in this file is based on earlier versions contributed
  8.  *    by Karl Lehenbauer, Mark Diekhans and Peter da Silva.
  9.  *
  10.  * Copyright (c) 1991-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1995 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  */
  16.  
  17. static char sccsid[] = "@(#) tclUnixAZ.c 1.85 95/06/29 14:22:37";
  18.  
  19. #include "tclInt.h"
  20. #include "tclPort.h"
  21.  
  22. /*
  23.  * The variable is a secret trap-door used by the "fileevent" command
  24.  * in Tk to destroy file event bindings whenever a file is closed.  I
  25.  * realize that this is a big ugly...
  26.  */
  27.  
  28. void (*tcl_FileCloseProc) _ANSI_ARGS_((FILE *f)) = NULL;
  29.  
  30. /*
  31.  * The variable below caches the name of the current working directory
  32.  * in order to avoid repeated calls to getcwd.  The string is malloc-ed.
  33.  * NULL means the cache needs to be refreshed.
  34.  */
  35.  
  36. static char *currentDir =  NULL;
  37.  
  38. /*
  39.  * If the system doesn't define one or both of the errno values EAGAIN
  40.  * and EWOULDBLOCK, #define them to a bogus value that will never occur.
  41.  */
  42.  
  43. #ifndef EAGAIN
  44. #   define EAGAIN -1901
  45. #endif
  46. #ifndef EWOULDBLOCK
  47. #   define EWOULDBLOCK -1901
  48. #endif
  49.  
  50. /*
  51.  * Prototypes for local procedures defined in this file:
  52.  */
  53.  
  54. static int        CleanupChildren _ANSI_ARGS_((Tcl_Interp *interp,
  55.                 int numPids, int *pidPtr, int errorId,
  56.                 int keepNewline));
  57. static char *        GetFileType _ANSI_ARGS_((int mode));
  58. static char *        GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
  59.                 char *string, int *modePtr));
  60. static int        StoreStatData _ANSI_ARGS_((Tcl_Interp *interp,
  61.                 char *varName, struct stat *statPtr));
  62.  
  63. /*
  64.  *----------------------------------------------------------------------
  65.  *
  66.  * Tcl_CdCmd --
  67.  *
  68.  *    This procedure is invoked to process the "cd" Tcl command.
  69.  *    See the user documentation for details on what it does.
  70.  *
  71.  * Results:
  72.  *    A standard Tcl result.
  73.  *
  74.  * Side effects:
  75.  *    See the user documentation.
  76.  *
  77.  *----------------------------------------------------------------------
  78.  */
  79.  
  80.     /* ARGSUSED */
  81. int
  82. Tcl_CdCmd(dummy, interp, argc, argv)
  83.     ClientData dummy;            /* Not used. */
  84.     Tcl_Interp *interp;            /* Current interpreter. */
  85.     int argc;                /* Number of arguments. */
  86.     char **argv;            /* Argument strings. */
  87. {
  88.     char *dirName;
  89.     Tcl_DString buffer;
  90.     int result;
  91.  
  92.     if (argc > 2) {
  93.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  94.         " dirName\"", (char *) NULL);
  95.     return TCL_ERROR;
  96.     }
  97.  
  98.     if (argc == 2) {
  99.     dirName = argv[1];
  100.     } else {
  101.     dirName = "~";
  102.     }
  103.     dirName = Tcl_TildeSubst(interp, dirName, &buffer);
  104.     if (dirName == NULL) {
  105.     return TCL_ERROR;
  106.     }
  107.     if (currentDir != NULL) {
  108.     ckfree(currentDir);
  109.     currentDir = NULL;
  110.     }
  111.     result = TCL_OK;
  112.     if (chdir(dirName) != 0) {
  113.     Tcl_AppendResult(interp, "couldn't change working directory to \"",
  114.         dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
  115.     result = TCL_ERROR;
  116.     }
  117.     Tcl_DStringFree(&buffer);
  118.     return result;
  119. }
  120.  
  121. /*
  122.  *----------------------------------------------------------------------
  123.  *
  124.  * Tcl_CloseCmd --
  125.  *
  126.  *    This procedure is invoked to process the "close" Tcl command.
  127.  *    See the user documentation for details on what it does.
  128.  *
  129.  * Results:
  130.  *    A standard Tcl result.
  131.  *
  132.  * Side effects:
  133.  *    See the user documentation.
  134.  *
  135.  *----------------------------------------------------------------------
  136.  */
  137.  
  138.     /* ARGSUSED */
  139. int
  140. Tcl_CloseCmd(dummy, interp, argc, argv)
  141.     ClientData dummy;            /* Not used. */
  142.     Tcl_Interp *interp;            /* Current interpreter. */
  143.     int argc;                /* Number of arguments. */
  144.     char **argv;            /* Argument strings. */
  145. {
  146.     OpenFile *oFilePtr;
  147.     int result = TCL_OK;
  148.     FILE *f;
  149.  
  150.     if (argc != 2) {
  151.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  152.         " fileId\"", (char *) NULL);
  153.     return TCL_ERROR;
  154.     }
  155.     if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
  156.     return TCL_ERROR;
  157.     }
  158.     oFilePtr = tclOpenFiles[fileno(f)];
  159.     tclOpenFiles[fileno(f)] = NULL;
  160.  
  161.     /*
  162.      * First close the file (in the case of a process pipeline, there may
  163.      * be two files, one for the pipe at each end of the pipeline).  The
  164.      * calls to *tcl_FileCloseProc are a hack so that Tk's "fileevent"
  165.      * command can clean up its state, if any, when files are closed.
  166.      */
  167.  
  168.     if (oFilePtr->f2 != NULL) {
  169.     if (tcl_FileCloseProc != NULL) {
  170.         (*tcl_FileCloseProc)(oFilePtr->f2);
  171.     }
  172.     clearerr(oFilePtr->f2);
  173.     if (fclose(oFilePtr->f2) == EOF) {
  174.         Tcl_AppendResult(interp, "error closing \"", argv[1],
  175.             "\": ", Tcl_PosixError(interp), "\n", (char *) NULL);
  176.         result = TCL_ERROR;
  177.     }
  178.     }
  179.     if (tcl_FileCloseProc != NULL) {
  180.     (*tcl_FileCloseProc)(oFilePtr->f);
  181.     }
  182.     clearerr(oFilePtr->f);
  183.     if (fclose(oFilePtr->f) == EOF) {
  184.     Tcl_AppendResult(interp, "error closing \"", argv[1],
  185.         "\": ", Tcl_PosixError(interp), "\n", (char *) NULL);
  186.     result = TCL_ERROR;
  187.     }
  188.  
  189.     /*
  190.      * If the file was a connection to a pipeline, clean up everything
  191.      * associated with the child processes.
  192.      */
  193.  
  194.     if (oFilePtr->numPids > 0) {
  195.     if (CleanupChildren(interp, oFilePtr->numPids, oFilePtr->pidPtr,
  196.         oFilePtr->errorId, 0) != TCL_OK) {
  197.         result = TCL_ERROR;
  198.     }
  199.     }
  200.  
  201.     ckfree((char *) oFilePtr);
  202.     return result;
  203. }
  204.  
  205. /*
  206.  *----------------------------------------------------------------------
  207.  *
  208.  * Tcl_EofCmd --
  209.  *
  210.  *    This procedure is invoked to process the "eof" Tcl command.
  211.  *    See the user documentation for details on what it does.
  212.  *
  213.  * Results:
  214.  *    A standard Tcl result.
  215.  *
  216.  * Side effects:
  217.  *    See the user documentation.
  218.  *
  219.  *----------------------------------------------------------------------
  220.  */
  221.  
  222.     /* ARGSUSED */
  223. int
  224. Tcl_EofCmd(notUsed, interp, argc, argv)
  225.     ClientData notUsed;            /* Not used. */
  226.     Tcl_Interp *interp;            /* Current interpreter. */
  227.     int argc;                /* Number of arguments. */
  228.     char **argv;            /* Argument strings. */
  229. {
  230.     FILE *f;
  231.  
  232.     if (argc != 2) {
  233.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  234.         " fileId\"", (char *) NULL);
  235.     return TCL_ERROR;
  236.     }
  237.     if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
  238.     return TCL_ERROR;
  239.     }
  240.     if (feof(f)) {
  241.     interp->result = "1";
  242.     } else {
  243.     interp->result = "0";
  244.     }
  245.     return TCL_OK;
  246. }
  247.  
  248. /*
  249.  *----------------------------------------------------------------------
  250.  *
  251.  * Tcl_ExecCmd --
  252.  *
  253.  *    This procedure is invoked to process the "exec" Tcl command.
  254.  *    See the user documentation for details on what it does.
  255.  *
  256.  * Results:
  257.  *    A standard Tcl result.
  258.  *
  259.  * Side effects:
  260.  *    See the user documentation.
  261.  *
  262.  *----------------------------------------------------------------------
  263.  */
  264.  
  265.     /* ARGSUSED */
  266. int
  267. Tcl_ExecCmd(dummy, interp, argc, argv)
  268.     ClientData dummy;            /* Not used. */
  269.     Tcl_Interp *interp;            /* Current interpreter. */
  270.     int argc;                /* Number of arguments. */
  271.     char **argv;            /* Argument strings. */
  272. {
  273.     int outputId;            /* File id for output pipe.  -1
  274.                      * means command overrode. */
  275.     int errorId;            /* File id for temporary file
  276.                      * containing error output. */
  277.     int *pidPtr;
  278.     int numPids, result, keepNewline;
  279.     int firstWord;
  280.  
  281.     /*
  282.      * Check for a leading "-keepnewline" argument.
  283.      */
  284.  
  285.     keepNewline = 0;
  286.     for (firstWord = 1; (firstWord < argc) && (argv[firstWord][0] == '-');
  287.         firstWord++) {
  288.     if (strcmp(argv[firstWord], "-keepnewline") == 0) {
  289.         keepNewline = 1;
  290.     } else if (strcmp(argv[firstWord], "--") == 0) {
  291.         firstWord++;
  292.         break;
  293.     } else {
  294.         Tcl_AppendResult(interp, "bad switch \"", argv[firstWord],
  295.             "\": must be -keepnewline or --", (char *) NULL);
  296.         return TCL_ERROR;
  297.     }
  298.     }
  299.  
  300.     if (argc <= firstWord) {
  301.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  302.         " ?switches? arg ?arg ...?\"", (char *) NULL);
  303.     return TCL_ERROR;
  304.     }
  305.  
  306.     /*
  307.      * See if the command is to be run in background;  if so, create
  308.      * the command, detach it, and return a list of pids.
  309.      */
  310.  
  311.     if ((argv[argc-1][0] == '&') && (argv[argc-1][1] == 0)) {
  312.     int i;
  313.     char id[50];
  314.  
  315.     argc--;
  316.     argv[argc] = NULL;
  317.     numPids = Tcl_CreatePipeline(interp, argc-firstWord, argv+firstWord,
  318.         &pidPtr, (int *) NULL, (int *) NULL, (int *) NULL);
  319.     if (numPids < 0) {
  320.         return TCL_ERROR;
  321.     }
  322.     Tcl_DetachPids(numPids, pidPtr);
  323.     for (i = 0; i < numPids; i++) {
  324.         sprintf(id, "%d", pidPtr[i]);
  325.         Tcl_AppendElement(interp, id);
  326.     }
  327.     ckfree((char *) pidPtr);
  328.     return TCL_OK;
  329.     }
  330.  
  331.     /*
  332.      * Create the command's pipeline.
  333.      */
  334.  
  335.     numPids = Tcl_CreatePipeline(interp, argc-firstWord, argv+firstWord,
  336.         &pidPtr, (int *) NULL, &outputId, &errorId);
  337.     if (numPids < 0) {
  338.     return TCL_ERROR;
  339.     }
  340.  
  341.     /*
  342.      * Read the child's output (if any) and put it into the result.
  343.      */
  344.  
  345.     result = TCL_OK;
  346.     if (outputId != -1) {
  347.     while (1) {
  348. #        define BUFFER_SIZE 1000
  349.         char buffer[BUFFER_SIZE+1];
  350.         int count;
  351.     
  352.         count = read(outputId, buffer, (size_t) BUFFER_SIZE);
  353.     
  354.         if (count == 0) {
  355.         break;
  356.         }
  357.         if (count < 0) {
  358.         Tcl_ResetResult(interp);
  359.         Tcl_AppendResult(interp,
  360.             "error reading from output pipe: ",
  361.             Tcl_PosixError(interp), (char *) NULL);
  362.         result = TCL_ERROR;
  363.         break;
  364.         }
  365.         buffer[count] = 0;
  366.         Tcl_AppendResult(interp, buffer, (char *) NULL);
  367.     }
  368.     close(outputId);
  369.     }
  370.  
  371.     if (CleanupChildren(interp, numPids, pidPtr, errorId, keepNewline)
  372.         != TCL_OK) {
  373.     result = TCL_ERROR;
  374.     }
  375.     return result;
  376. }
  377.  
  378. /*
  379.  *----------------------------------------------------------------------
  380.  *
  381.  * Tcl_ExitCmd --
  382.  *
  383.  *    This procedure is invoked to process the "exit" Tcl command.
  384.  *    See the user documentation for details on what it does.
  385.  *
  386.  * Results:
  387.  *    A standard Tcl result.
  388.  *
  389.  * Side effects:
  390.  *    See the user documentation.
  391.  *
  392.  *----------------------------------------------------------------------
  393.  */
  394.  
  395.     /* ARGSUSED */
  396. int
  397. Tcl_ExitCmd(dummy, interp, argc, argv)
  398.     ClientData dummy;            /* Not used. */
  399.     Tcl_Interp *interp;            /* Current interpreter. */
  400.     int argc;                /* Number of arguments. */
  401.     char **argv;            /* Argument strings. */
  402. {
  403.     int value;
  404.  
  405.     if ((argc != 1) && (argc != 2)) {
  406.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  407.         " ?returnCode?\"", (char *) NULL);
  408.     return TCL_ERROR;
  409.     }
  410.     if (argc == 1) {
  411.     exit(0);
  412.     }
  413.     if (Tcl_GetInt(interp, argv[1], &value) != TCL_OK) {
  414.     return TCL_ERROR;
  415.     }
  416.     exit(value);
  417.     /*NOTREACHED*/
  418.     return TCL_OK;            /* Better not ever reach this! */
  419. }
  420.  
  421. /*
  422.  *----------------------------------------------------------------------
  423.  *
  424.  * Tcl_FileCmd --
  425.  *
  426.  *    This procedure is invoked to process the "file" Tcl command.
  427.  *    See the user documentation for details on what it does.
  428.  *
  429.  * Results:
  430.  *    A standard Tcl result.
  431.  *
  432.  * Side effects:
  433.  *    See the user documentation.
  434.  *
  435.  *----------------------------------------------------------------------
  436.  */
  437.  
  438.     /* ARGSUSED */
  439. int
  440. Tcl_FileCmd(dummy, interp, argc, argv)
  441.     ClientData dummy;            /* Not used. */
  442.     Tcl_Interp *interp;            /* Current interpreter. */
  443.     int argc;                /* Number of arguments. */
  444.     char **argv;            /* Argument strings. */
  445. {
  446.     char *p, *fileName;
  447.     int c, statOp, result;
  448.     size_t length;
  449.     int mode = 0;            /* Initialized only to prevent
  450.                      * compiler warning message. */
  451.     struct stat statBuf;
  452.     Tcl_DString buffer;
  453.  
  454.     if (argc < 3) {
  455.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  456.         " option name ?arg ...?\"", (char *) NULL);
  457.     return TCL_ERROR;
  458.     }
  459.     c = argv[1][0];
  460.     length = strlen(argv[1]);
  461.     result = TCL_OK;
  462.  
  463.     /*
  464.      * First handle operations on the file name.
  465.      */
  466.  
  467.     fileName = Tcl_TildeSubst(interp, argv[2], &buffer);
  468.     if (fileName == NULL) {
  469.     result = TCL_ERROR;
  470.     goto done;
  471.     }
  472.     if ((c == 'd') && (strncmp(argv[1], "dirname", length) == 0)) {
  473.     if (argc != 3) {
  474.         argv[1] = "dirname";
  475.         not3Args:
  476.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  477.             " ", argv[1], " name\"", (char *) NULL);
  478.         result = TCL_ERROR;
  479.         goto done;
  480.     }
  481.     p = strrchr(fileName, '/');
  482.     if (p == NULL) {
  483.         interp->result = ".";
  484.     } else if (p == fileName) {
  485.         interp->result = "/";
  486.     } else {
  487.         *p = 0;
  488.         Tcl_SetResult(interp, fileName, TCL_VOLATILE);
  489.         *p = '/';
  490.     }
  491.     goto done;
  492.     } else if ((c == 'r') && (strncmp(argv[1], "rootname", length) == 0)
  493.         && (length >= 2)) {
  494.     char *lastSlash;
  495.  
  496.     if (argc != 3) {
  497.         argv[1] = "rootname";
  498.         goto not3Args;
  499.     }
  500.     p = strrchr(fileName, '.');
  501.     lastSlash = strrchr(fileName, '/');
  502.     if ((p == NULL) || ((lastSlash != NULL) && (lastSlash > p))) {
  503.         Tcl_SetResult(interp, fileName, TCL_VOLATILE);
  504.     } else {
  505.         *p = 0;
  506.         Tcl_SetResult(interp, fileName, TCL_VOLATILE);
  507.         *p = '.';
  508.     }
  509.     goto done;
  510.     } else if ((c == 'e') && (strncmp(argv[1], "extension", length) == 0)
  511.         && (length >= 3)) {
  512.     char *lastSlash;
  513.  
  514.     if (argc != 3) {
  515.         argv[1] = "extension";
  516.         goto not3Args;
  517.     }
  518.     p = strrchr(fileName, '.');
  519.     lastSlash = strrchr(fileName, '/');
  520.     if ((p != NULL) && ((lastSlash == NULL) || (lastSlash < p))) {
  521.         Tcl_SetResult(interp, p, TCL_VOLATILE);
  522.     }
  523.     goto done;
  524.     } else if ((c == 't') && (strncmp(argv[1], "tail", length) == 0)
  525.         && (length >= 2)) {
  526.     if (argc != 3) {
  527.         argv[1] = "tail";
  528.         goto not3Args;
  529.     }
  530.     p = strrchr(fileName, '/');
  531.     if (p != NULL) {
  532.         Tcl_SetResult(interp, p+1, TCL_VOLATILE);
  533.     } else {
  534.         Tcl_SetResult(interp, fileName, TCL_VOLATILE);
  535.     }
  536.     goto done;
  537.     }
  538.  
  539.     /*
  540.      * Next, handle operations that can be satisfied with the "access"
  541.      * kernel call.
  542.      */
  543.  
  544.     if (fileName == NULL) {
  545.     result = TCL_ERROR;
  546.     goto done;
  547.     }
  548.     if ((c == 'r') && (strncmp(argv[1], "readable", length) == 0)
  549.         && (length >= 5)) {
  550.     if (argc != 3) {
  551.         argv[1] = "readable";
  552.         goto not3Args;
  553.     }
  554.     mode = R_OK;
  555.     checkAccess:
  556.     if (access(fileName, mode) == -1) {
  557.         interp->result = "0";
  558.     } else {
  559.         interp->result = "1";
  560.     }
  561.     goto done;
  562.     } else if ((c == 'w') && (strncmp(argv[1], "writable", length) == 0)) {
  563.     if (argc != 3) {
  564.         argv[1] = "writable";
  565.         goto not3Args;
  566.     }
  567.     mode = W_OK;
  568.     goto checkAccess;
  569.     } else if ((c == 'e') && (strncmp(argv[1], "executable", length) == 0)
  570.         && (length >= 3)) {
  571.     if (argc != 3) {
  572.         argv[1] = "executable";
  573.         goto not3Args;
  574.     }
  575.     mode = X_OK;
  576.     goto checkAccess;
  577.     } else if ((c == 'e') && (strncmp(argv[1], "exists", length) == 0)
  578.         && (length >= 3)) {
  579.     if (argc != 3) {
  580.         argv[1] = "exists";
  581.         goto not3Args;
  582.     }
  583.     mode = F_OK;
  584.     goto checkAccess;
  585.     }
  586.  
  587.     /*
  588.      * Lastly, check stuff that requires the file to be stat-ed.
  589.      */
  590.  
  591.     if ((c == 'a') && (strncmp(argv[1], "atime", length) == 0)) {
  592.     if (argc != 3) {
  593.         argv[1] = "atime";
  594.         goto not3Args;
  595.     }
  596.     if (stat(fileName, &statBuf) == -1) {
  597.         goto badStat;
  598.     }
  599.     sprintf(interp->result, "%ld", statBuf.st_atime);
  600.     goto done;
  601.     } else if ((c == 'i') && (strncmp(argv[1], "isdirectory", length) == 0)
  602.         && (length >= 3)) {
  603.     if (argc != 3) {
  604.         argv[1] = "isdirectory";
  605.         goto not3Args;
  606.     }
  607.     statOp = 2;
  608.     } else if ((c == 'i') && (strncmp(argv[1], "isfile", length) == 0)
  609.         && (length >= 3)) {
  610.     if (argc != 3) {
  611.         argv[1] = "isfile";
  612.         goto not3Args;
  613.     }
  614.     statOp = 1;
  615.     } else if ((c == 'l') && (strncmp(argv[1], "lstat", length) == 0)) {
  616.     if (argc != 4) {
  617.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  618.             " lstat name varName\"", (char *) NULL);
  619.         result = TCL_ERROR;
  620.         goto done;
  621.     }
  622.  
  623.     if (lstat(fileName, &statBuf) == -1) {
  624.         Tcl_AppendResult(interp, "couldn't lstat \"", argv[2],
  625.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  626.         result = TCL_ERROR;
  627.         goto done;
  628.     }
  629.     result = StoreStatData(interp, argv[3], &statBuf);
  630.     goto done;
  631.     } else if ((c == 'm') && (strncmp(argv[1], "mtime", length) == 0)) {
  632.     if (argc != 3) {
  633.         argv[1] = "mtime";
  634.         goto not3Args;
  635.     }
  636.     if (stat(fileName, &statBuf) == -1) {
  637.         goto badStat;
  638.     }
  639.     sprintf(interp->result, "%ld", statBuf.st_mtime);
  640.     goto done;
  641.     } else if ((c == 'o') && (strncmp(argv[1], "owned", length) == 0)) {
  642.     if (argc != 3) {
  643.         argv[1] = "owned";
  644.         goto not3Args;
  645.     }
  646.     statOp = 0;
  647.     } else if ((c == 'r') && (strncmp(argv[1], "readlink", length) == 0)
  648.         && (length >= 5)) {
  649.     char linkValue[MAXPATHLEN+1];
  650.     int linkLength;
  651.  
  652.     if (argc != 3) {
  653.         argv[1] = "readlink";
  654.         goto not3Args;
  655.     }
  656.  
  657.     /*
  658.      * If S_IFLNK isn't defined it means that the machine doesn't
  659.      * support symbolic links, so the file can't possibly be a
  660.      * symbolic link.  Generate an EINVAL error, which is what
  661.      * happens on machines that do support symbolic links when
  662.      * you invoke readlink on a file that isn't a symbolic link.
  663.      */
  664.  
  665. #ifndef S_IFLNK
  666.     linkLength = -1;
  667.     errno = EINVAL;
  668. #else
  669.     linkLength = readlink(fileName, linkValue, sizeof(linkValue) - 1);
  670. #endif /* S_IFLNK */
  671.     if (linkLength == -1) {
  672.         Tcl_AppendResult(interp, "couldn't readlink \"", argv[2],
  673.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  674.         result = TCL_ERROR;
  675.         goto done;
  676.     }
  677.     linkValue[linkLength] = 0;
  678.     Tcl_SetResult(interp, linkValue, TCL_VOLATILE);
  679.     goto done;
  680.     } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
  681.         && (length >= 2)) {
  682.     if (argc != 3) {
  683.         argv[1] = "size";
  684.         goto not3Args;
  685.     }
  686.     if (stat(fileName, &statBuf) == -1) {
  687.         goto badStat;
  688.     }
  689.     sprintf(interp->result, "%ld", statBuf.st_size);
  690.     goto done;
  691.     } else if ((c == 's') && (strncmp(argv[1], "stat", length) == 0)
  692.         && (length >= 2)) {
  693.     if (argc != 4) {
  694.         Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  695.             " stat name varName\"", (char *) NULL);
  696.         result = TCL_ERROR;
  697.         goto done;
  698.     }
  699.  
  700.     if (stat(fileName, &statBuf) == -1) {
  701.         badStat:
  702.         Tcl_AppendResult(interp, "couldn't stat \"", argv[2],
  703.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  704.         result = TCL_ERROR;
  705.         goto done;
  706.     }
  707.     result = StoreStatData(interp, argv[3], &statBuf);
  708.     goto done;
  709.     } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)
  710.         && (length >= 2)) {
  711.     if (argc != 3) {
  712.         argv[1] = "type";
  713.         goto not3Args;
  714.     }
  715.     if (lstat(fileName, &statBuf) == -1) {
  716.         goto badStat;
  717.     }
  718.     interp->result = GetFileType((int) statBuf.st_mode);
  719.     goto done;
  720.     } else {
  721.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  722.         "\": should be atime, dirname, executable, exists, ",
  723.         "extension, isdirectory, isfile, lstat, mtime, owned, ",
  724.         "readable, readlink, ",
  725.         "root, size, stat, tail, type, ",
  726.         "or writable",
  727.         (char *) NULL);
  728.     result = TCL_ERROR;
  729.     goto done;
  730.     }
  731.     if (stat(fileName, &statBuf) == -1) {
  732.     interp->result = "0";
  733.     goto done;
  734.     }
  735.     switch (statOp) {
  736.     case 0:
  737.         mode = (geteuid() == statBuf.st_uid);
  738.         break;
  739.     case 1:
  740.         mode = S_ISREG(statBuf.st_mode);
  741.         break;
  742.     case 2:
  743.         mode = S_ISDIR(statBuf.st_mode);
  744.         break;
  745.     }
  746.     if (mode) {
  747.     interp->result = "1";
  748.     } else {
  749.     interp->result = "0";
  750.     }
  751.  
  752.     done:
  753.     Tcl_DStringFree(&buffer);
  754.     return result;
  755. }
  756.  
  757. /*
  758.  *----------------------------------------------------------------------
  759.  *
  760.  * StoreStatData --
  761.  *
  762.  *    This is a utility procedure that breaks out the fields of a
  763.  *    "stat" structure and stores them in textual form into the
  764.  *    elements of an associative array.
  765.  *
  766.  * Results:
  767.  *    Returns a standard Tcl return value.  If an error occurs then
  768.  *    a message is left in interp->result.
  769.  *
  770.  * Side effects:
  771.  *    Elements of the associative array given by "varName" are modified.
  772.  *
  773.  *----------------------------------------------------------------------
  774.  */
  775.  
  776. static int
  777. StoreStatData(interp, varName, statPtr)
  778.     Tcl_Interp *interp;            /* Interpreter for error reports. */
  779.     char *varName;            /* Name of associative array variable
  780.                      * in which to store stat results. */
  781.     struct stat *statPtr;        /* Pointer to buffer containing
  782.                      * stat data to store in varName. */
  783. {
  784.     char string[30];
  785.  
  786.     sprintf(string, "%ld", statPtr->st_dev);
  787.     if (Tcl_SetVar2(interp, varName, "dev", string, TCL_LEAVE_ERR_MSG)
  788.         == NULL) {
  789.     return TCL_ERROR;
  790.     }
  791.     sprintf(string, "%ld", statPtr->st_ino);
  792.     if (Tcl_SetVar2(interp, varName, "ino", string, TCL_LEAVE_ERR_MSG)
  793.         == NULL) {
  794.     return TCL_ERROR;
  795.     }
  796.     sprintf(string, "%ld", statPtr->st_mode);
  797.     if (Tcl_SetVar2(interp, varName, "mode", string, TCL_LEAVE_ERR_MSG)
  798.         == NULL) {
  799.     return TCL_ERROR;
  800.     }
  801.     sprintf(string, "%ld", statPtr->st_nlink);
  802.     if (Tcl_SetVar2(interp, varName, "nlink", string, TCL_LEAVE_ERR_MSG)
  803.         == NULL) {
  804.     return TCL_ERROR;
  805.     }
  806.     sprintf(string, "%ld", (long) statPtr->st_uid);
  807.     if (Tcl_SetVar2(interp, varName, "uid", string, TCL_LEAVE_ERR_MSG)
  808.         == NULL) {
  809.     return TCL_ERROR;
  810.     }
  811.     sprintf(string, "%ld", (long) statPtr->st_gid);
  812.     if (Tcl_SetVar2(interp, varName, "gid", string, TCL_LEAVE_ERR_MSG)
  813.         == NULL) {
  814.     return TCL_ERROR;
  815.     }
  816.     sprintf(string, "%ld", statPtr->st_size);
  817.     if (Tcl_SetVar2(interp, varName, "size", string, TCL_LEAVE_ERR_MSG)
  818.         == NULL) {
  819.     return TCL_ERROR;
  820.     }
  821.     sprintf(string, "%ld", statPtr->st_atime);
  822.     if (Tcl_SetVar2(interp, varName, "atime", string, TCL_LEAVE_ERR_MSG)
  823.         == NULL) {
  824.     return TCL_ERROR;
  825.     }
  826.     sprintf(string, "%ld", statPtr->st_mtime);
  827.     if (Tcl_SetVar2(interp, varName, "mtime", string, TCL_LEAVE_ERR_MSG)
  828.         == NULL) {
  829.     return TCL_ERROR;
  830.     }
  831.     sprintf(string, "%ld", statPtr->st_ctime);
  832.     if (Tcl_SetVar2(interp, varName, "ctime", string, TCL_LEAVE_ERR_MSG)
  833.         == NULL) {
  834.     return TCL_ERROR;
  835.     }
  836.     if (Tcl_SetVar2(interp, varName, "type",
  837.         GetFileType((int) statPtr->st_mode), TCL_LEAVE_ERR_MSG) == NULL) {
  838.     return TCL_ERROR;
  839.     }
  840.     return TCL_OK;
  841. }
  842.  
  843. /*
  844.  *----------------------------------------------------------------------
  845.  *
  846.  * GetFileType --
  847.  *
  848.  *    Given a mode word, returns a string identifying the type of a
  849.  *    file.
  850.  *
  851.  * Results:
  852.  *    A static text string giving the file type from mode.
  853.  *
  854.  * Side effects:
  855.  *    None.
  856.  *
  857.  *----------------------------------------------------------------------
  858.  */
  859.  
  860. static char *
  861. GetFileType(mode)
  862.     int mode;
  863. {
  864.     if (S_ISREG(mode)) {
  865.     return "file";
  866.     } else if (S_ISDIR(mode)) {
  867.     return "directory";
  868.     } else if (S_ISCHR(mode)) {
  869.     return "characterSpecial";
  870.     } else if (S_ISBLK(mode)) {
  871.     return "blockSpecial";
  872.     } else if (S_ISFIFO(mode)) {
  873.     return "fifo";
  874.     } else if (S_ISLNK(mode)) {
  875.     return "link";
  876.     } else if (S_ISSOCK(mode)) {
  877.     return "socket";
  878.     }
  879.     return "unknown";
  880. }
  881.  
  882. /*
  883.  *----------------------------------------------------------------------
  884.  *
  885.  * Tcl_FlushCmd --
  886.  *
  887.  *    This procedure is invoked to process the "flush" Tcl command.
  888.  *    See the user documentation for details on what it does.
  889.  *
  890.  * Results:
  891.  *    A standard Tcl result.
  892.  *
  893.  * Side effects:
  894.  *    See the user documentation.
  895.  *
  896.  *----------------------------------------------------------------------
  897.  */
  898.  
  899.     /* ARGSUSED */
  900. int
  901. Tcl_FlushCmd(notUsed, interp, argc, argv)
  902.     ClientData notUsed;            /* Not used. */
  903.     Tcl_Interp *interp;            /* Current interpreter. */
  904.     int argc;                /* Number of arguments. */
  905.     char **argv;            /* Argument strings. */
  906. {
  907.     FILE *f;
  908.  
  909.     if (argc != 2) {
  910.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  911.         " fileId\"", (char *) NULL);
  912.     return TCL_ERROR;
  913.     }
  914.     if (Tcl_GetOpenFile(interp, argv[1], 1, 1, &f) != TCL_OK) {
  915.     return TCL_ERROR;
  916.     }
  917.     clearerr(f);
  918.     if (fflush(f) == EOF) {
  919.     Tcl_AppendResult(interp, "error flushing \"", argv[1],
  920.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  921.     return TCL_ERROR;
  922.     }
  923.     return TCL_OK;
  924. }
  925.  
  926. /*
  927.  *----------------------------------------------------------------------
  928.  *
  929.  * Tcl_GetsCmd --
  930.  *
  931.  *    This procedure is invoked to process the "gets" Tcl command.
  932.  *    See the user documentation for details on what it does.
  933.  *
  934.  * Results:
  935.  *    A standard Tcl result.
  936.  *
  937.  * Side effects:
  938.  *    See the user documentation.
  939.  *
  940.  *----------------------------------------------------------------------
  941.  */
  942.  
  943.     /* ARGSUSED */
  944. int
  945. Tcl_GetsCmd(notUsed, interp, argc, argv)
  946.     ClientData notUsed;            /* Not used. */
  947.     Tcl_Interp *interp;            /* Current interpreter. */
  948.     int argc;                /* Number of arguments. */
  949.     char **argv;            /* Argument strings. */
  950. {
  951. #   define BUF_SIZE 200
  952.     char buffer[BUF_SIZE+1];
  953.     int totalCount, done, flags;
  954.     FILE *f;
  955.  
  956.     if ((argc != 2) && (argc != 3)) {
  957.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  958.         " fileId ?varName?\"", (char *) NULL);
  959.     return TCL_ERROR;
  960.     }
  961.     if (Tcl_GetOpenFile(interp, argv[1], 0, 1, &f) != TCL_OK) {
  962.     return TCL_ERROR;
  963.     }
  964.  
  965.     /*
  966.      * We can't predict how large a line will be, so read it in
  967.      * pieces, appending to the current result or to a variable.
  968.      */
  969.  
  970.     totalCount = 0;
  971.     done = 0;
  972.     flags = 0;
  973.     clearerr(f);
  974.     while (!done) {
  975.     register int c, count;
  976.     register char *p;
  977.  
  978.     for (p = buffer, count = 0; count < BUF_SIZE-1; count++, p++) {
  979.         c = getc(f);
  980.         if (c == EOF) {
  981.         if (ferror(f)) {
  982.             /*
  983.              * If the file is in non-blocking mode, return any
  984.              * bytes that were read before a block would occur.
  985.              */
  986.  
  987.             if (((errno == EWOULDBLOCK) || (errno == EAGAIN))
  988.                 && ((count > 0 || totalCount > 0))) {
  989.             done = 1;
  990.             break;
  991.             }
  992.             Tcl_ResetResult(interp);
  993.             Tcl_AppendResult(interp, "error reading \"", argv[1],
  994.                 "\": ", Tcl_PosixError(interp), (char *) NULL);
  995.             return TCL_ERROR;
  996.         } else if (feof(f)) {
  997.             if ((totalCount == 0) && (count == 0)) {
  998.             totalCount = -1;
  999.             }
  1000.             done = 1;
  1001.             break;
  1002.         }
  1003.         }
  1004.         if (c == '\n') {
  1005.         done = 1;
  1006.         break;
  1007.         }
  1008.         *p = c;
  1009.     }
  1010.     *p = 0;
  1011.     if (argc == 2) {
  1012.         Tcl_AppendResult(interp, buffer, (char *) NULL);
  1013.     } else {
  1014.         if (Tcl_SetVar(interp, argv[2], buffer, flags|TCL_LEAVE_ERR_MSG)
  1015.             == NULL) {
  1016.         return TCL_ERROR;
  1017.         }
  1018.         flags = TCL_APPEND_VALUE;
  1019.     }
  1020.     totalCount += count;
  1021.     }
  1022.  
  1023.     if (argc == 3) {
  1024.     sprintf(interp->result, "%d", totalCount);
  1025.     }
  1026.     return TCL_OK;
  1027. }
  1028.  
  1029. /*
  1030.  *----------------------------------------------------------------------
  1031.  *
  1032.  * Tcl_OpenCmd --
  1033.  *
  1034.  *    This procedure is invoked to process the "open" Tcl command.
  1035.  *    See the user documentation for details on what it does.
  1036.  *
  1037.  * Results:
  1038.  *    A standard Tcl result.
  1039.  *
  1040.  * Side effects:
  1041.  *    See the user documentation.
  1042.  *
  1043.  *----------------------------------------------------------------------
  1044.  */
  1045.  
  1046.     /* ARGSUSED */
  1047. int
  1048. Tcl_OpenCmd(notUsed, interp, argc, argv)
  1049.     ClientData notUsed;            /* Not used. */
  1050.     Tcl_Interp *interp;            /* Current interpreter. */
  1051.     int argc;                /* Number of arguments. */
  1052.     char **argv;            /* Argument strings. */
  1053. {
  1054.     int pipeline, fd, mode, prot, readWrite, permissions;
  1055.     char *access;
  1056.     FILE *f, *f2;
  1057.  
  1058.     if ((argc < 2) || (argc > 4)) {
  1059.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1060.         " filename ?access? ?permissions?\"", (char *) NULL);
  1061.     return TCL_ERROR;
  1062.     }
  1063.     prot = 0666;
  1064.     if (argc == 2) {
  1065.     mode = O_RDONLY;
  1066.     access = "r";
  1067.     } else {
  1068.     access = GetOpenMode(interp, argv[2], &mode);
  1069.     if (access == NULL) {
  1070.         return TCL_ERROR;
  1071.     }
  1072.     if (argc == 4) {
  1073.         if (Tcl_GetInt(interp, argv[3], &prot) != TCL_OK) {
  1074.         return TCL_ERROR;
  1075.         }
  1076.     }
  1077.     }
  1078.  
  1079.     f = f2 = NULL;
  1080.     readWrite = mode & (O_RDWR|O_RDONLY|O_WRONLY);
  1081.     if (readWrite == O_RDONLY) {
  1082.     permissions = TCL_FILE_READABLE;
  1083.     } else if (readWrite == O_WRONLY) {
  1084.     permissions = TCL_FILE_WRITABLE;
  1085.     } else {
  1086.     permissions = TCL_FILE_READABLE|TCL_FILE_WRITABLE;
  1087.     }
  1088.  
  1089.     pipeline = 0;
  1090.     if (argv[1][0] == '|') {
  1091.     pipeline = 1;
  1092.     }
  1093.  
  1094.     /*
  1095.      * Open the file or create a process pipeline.
  1096.      */
  1097.  
  1098.     if (!pipeline) {
  1099.     char *fileName;
  1100.     Tcl_DString buffer;
  1101.  
  1102.     fileName = Tcl_TildeSubst(interp, argv[1], &buffer);
  1103.     if (fileName == NULL) {
  1104.         return TCL_ERROR;
  1105.     }
  1106.     fd = open(fileName, mode, prot);
  1107.     Tcl_DStringFree(&buffer);
  1108.     if (fd < 0) {
  1109.         Tcl_AppendResult(interp, "couldn't open \"", argv[1],
  1110.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  1111.         return TCL_ERROR;
  1112.     }
  1113.     f = fdopen(fd, access);
  1114.     if (f == NULL) {
  1115.         close(fd);
  1116.         return TCL_ERROR;
  1117.     }
  1118.     Tcl_EnterFile(interp, f, permissions);
  1119.     } else {
  1120.     int *inPipePtr, *outPipePtr;
  1121.     int cmdArgc, inPipe, outPipe, numPids, *pidPtr, errorId;
  1122.     char **cmdArgv;
  1123.     OpenFile *oFilePtr;
  1124.  
  1125.     if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
  1126.         return TCL_ERROR;
  1127.     }
  1128.     inPipePtr = (permissions & TCL_FILE_WRITABLE) ? &inPipe : NULL;
  1129.     outPipePtr = (permissions & TCL_FILE_READABLE) ? &outPipe : NULL;
  1130.     inPipe = outPipe = errorId = -1;
  1131.     numPids = Tcl_CreatePipeline(interp, cmdArgc, cmdArgv,
  1132.         &pidPtr, inPipePtr, outPipePtr, &errorId);
  1133.     ckfree((char *) cmdArgv);
  1134.     if (numPids < 0) {
  1135.         pipelineError:
  1136.         if (f != NULL) {
  1137.         fclose(f);
  1138.         }
  1139.         if (f2 != NULL) {
  1140.         fclose(f2);
  1141.         }
  1142.         if (numPids > 0) {
  1143.         Tcl_DetachPids(numPids, pidPtr);
  1144.         ckfree((char *) pidPtr);
  1145.         }
  1146.         if (errorId != -1) {
  1147.         close(errorId);
  1148.         }
  1149.         return TCL_ERROR;
  1150.     }
  1151.     if (permissions & TCL_FILE_READABLE) {
  1152.         if (outPipe == -1) {
  1153.         if (inPipe != -1) {
  1154.             close(inPipe);
  1155.         }
  1156.         Tcl_AppendResult(interp, "can't read output from command:",
  1157.             " standard output was redirected", (char *) NULL);
  1158.         goto pipelineError;
  1159.         }
  1160.         f = fdopen(outPipe, "r");
  1161.     }
  1162.     if (permissions & TCL_FILE_WRITABLE) {
  1163.         if (inPipe == -1) {
  1164.         Tcl_AppendResult(interp, "can't write input to command:",
  1165.             " standard input was redirected", (char *) NULL);
  1166.         goto pipelineError;
  1167.         }
  1168.         if (f != NULL) {
  1169.         f2 = fdopen(inPipe, "w");
  1170.         } else {
  1171.         f = fdopen(inPipe, "w");
  1172.         }
  1173.     }
  1174.     Tcl_EnterFile(interp, f, permissions);
  1175.     oFilePtr = tclOpenFiles[fileno(f)];
  1176.     oFilePtr->f2 = f2;
  1177.     oFilePtr->numPids = numPids;
  1178.     oFilePtr->pidPtr = pidPtr;
  1179.     oFilePtr->errorId = errorId;
  1180.     }
  1181.     return TCL_OK;
  1182. }
  1183.  
  1184. /*
  1185.  *----------------------------------------------------------------------
  1186.  *
  1187.  * GetOpenMode --
  1188.  *
  1189.  *    description.
  1190.  *
  1191.  * Results:
  1192.  *    Normally, sets *modePtr to an access mode for passing to "open",
  1193.  *    and returns a string that can be used as the access mode in a
  1194.  *    subsequent call to "fdopen".  If an error occurs, then returns
  1195.  *    NULL and sets interp->result to an error message.
  1196.  *
  1197.  * Side effects:
  1198.  *    None.
  1199.  *
  1200.  * Special note:
  1201.  *    This code is based on a prototype implementation contributed
  1202.  *    by Mark Diekhans.
  1203.  *
  1204.  *----------------------------------------------------------------------
  1205.  */
  1206.  
  1207. static char *
  1208. GetOpenMode(interp, string, modePtr)
  1209.     Tcl_Interp *interp;            /* Interpreter to use for error
  1210.                      * reporting. */
  1211.     char *string;            /* Mode string, e.g. "r+" or
  1212.                      * "RDONLY CREAT". */
  1213.     int *modePtr;            /* Where to store mode corresponding
  1214.                      * to string. */
  1215. {
  1216.     int mode, modeArgc, c, i, gotRW;
  1217.     char **modeArgv, *flag;
  1218. #define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
  1219.  
  1220.     /*
  1221.      * Check for the simpler fopen-like access modes (e.g. "r").  They
  1222.      * are distinguished from the POSIX access modes by the presence
  1223.      * of a lower-case first letter.
  1224.      */
  1225.  
  1226.     mode = 0;
  1227.     if (islower(UCHAR(string[0]))) {
  1228.     switch (string[0]) {
  1229.         case 'r':
  1230.         mode = O_RDONLY;
  1231.         break;
  1232.         case 'w':
  1233.         mode = O_WRONLY|O_CREAT|O_TRUNC;
  1234.         break;
  1235.         case 'a':
  1236.         mode = O_WRONLY|O_CREAT|O_APPEND;
  1237.         break;
  1238.         default:
  1239.         error:
  1240.         Tcl_AppendResult(interp,
  1241.             "illegal access mode \"", string, "\"", (char *) NULL);
  1242.         return NULL;
  1243.     }
  1244.     if (string[1] == '+') {
  1245.         mode &= ~(O_RDONLY|O_WRONLY);
  1246.         mode |= O_RDWR;
  1247.         if (string[2] != 0) {
  1248.         goto error;
  1249.         }
  1250.     } else if (string[1] != 0) {
  1251.         goto error;
  1252.     }
  1253.     *modePtr = mode;
  1254.     return string;
  1255.     }
  1256.  
  1257.     /*
  1258.      * The access modes are specified using a list of POSIX modes
  1259.      * such as O_CREAT.
  1260.      */
  1261.  
  1262.     if (Tcl_SplitList(interp, string, &modeArgc, &modeArgv) != TCL_OK) {
  1263.     Tcl_AddErrorInfo(interp, "\n    while processing open access modes \"");
  1264.     Tcl_AddErrorInfo(interp, string);
  1265.     Tcl_AddErrorInfo(interp, "\"");
  1266.     return NULL;
  1267.     }
  1268.     gotRW = 0;
  1269.     for (i = 0; i < modeArgc; i++) {
  1270.     flag = modeArgv[i];
  1271.     c = flag[0];
  1272.     if ((c == 'R') && (strcmp(flag, "RDONLY") == 0)) {
  1273.         mode = (mode & ~RW_MODES) | O_RDONLY;
  1274.         gotRW = 1;
  1275.     } else if ((c == 'W') && (strcmp(flag, "WRONLY") == 0)) {
  1276.         mode = (mode & ~RW_MODES) | O_WRONLY;
  1277.         gotRW = 1;
  1278.     } else if ((c == 'R') && (strcmp(flag, "RDWR") == 0)) {
  1279.         mode = (mode & ~RW_MODES) | O_RDWR;
  1280.         gotRW = 1;
  1281.     } else if ((c == 'A') && (strcmp(flag, "APPEND") == 0)) {
  1282.         mode |= O_APPEND;
  1283.     } else if ((c == 'C') && (strcmp(flag, "CREAT") == 0)) {
  1284.         mode |= O_CREAT;
  1285.     } else if ((c == 'E') && (strcmp(flag, "EXCL") == 0)) {
  1286.         mode |= O_EXCL;
  1287.     } else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
  1288. #ifdef O_NOCTTY
  1289.         mode |= O_NOCTTY;
  1290. #else
  1291.         Tcl_AppendResult(interp, "access mode \"", flag,
  1292.             "\" not supported by this system", (char *) NULL);
  1293.         ckfree((char *) modeArgv);
  1294.         return NULL;
  1295. #endif
  1296.     } else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
  1297. #ifdef O_NONBLOCK
  1298.         mode |= O_NONBLOCK;
  1299. #else
  1300.         mode |= O_NDELAY;
  1301. #endif
  1302.     } else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
  1303.         mode |= O_TRUNC;
  1304.     } else {
  1305.         Tcl_AppendResult(interp, "invalid access mode \"", flag,
  1306.             "\": must be RDONLY, WRONLY, RDWR, APPEND, CREAT",
  1307.             " EXCL, NOCTTY, NONBLOCK, or TRUNC", (char *) NULL);
  1308.         ckfree((char *) modeArgv);
  1309.         return NULL;
  1310.     }
  1311.     }
  1312.     ckfree((char *) modeArgv);
  1313.     if (!gotRW) {
  1314.     Tcl_AppendResult(interp, "access mode must include either",
  1315.         " RDONLY, WRONLY, or RDWR", (char *) NULL);
  1316.     return NULL;
  1317.     }
  1318.     *modePtr = mode;
  1319.  
  1320.     /*
  1321.      * The calculation of fdopen access mode below isn't really correct,
  1322.      * but it doesn't have to be.  All it has to do is to disinguish
  1323.      * read and write permissions, plus indicate append mode.
  1324.      */
  1325.  
  1326.     i = mode & RW_MODES;
  1327.     if (i == O_RDONLY) {
  1328.     return "r";
  1329.     }
  1330.     if (mode & O_APPEND) {
  1331.     if (i == O_WRONLY) {
  1332.         return "a";
  1333.     } else {
  1334.         return "a+";
  1335.     }
  1336.     }
  1337.     if (i == O_WRONLY) {
  1338.     return "w";
  1339.     }
  1340.     return "r+";
  1341. }
  1342.  
  1343. /*
  1344.  *----------------------------------------------------------------------
  1345.  *
  1346.  * Tcl_PidCmd --
  1347.  *
  1348.  *    This procedure is invoked to process the "pid" Tcl command.
  1349.  *    See the user documentation for details on what it does.
  1350.  *
  1351.  * Results:
  1352.  *    A standard Tcl result.
  1353.  *
  1354.  * Side effects:
  1355.  *    See the user documentation.
  1356.  *
  1357.  *----------------------------------------------------------------------
  1358.  */
  1359.  
  1360.     /* ARGSUSED */
  1361. int
  1362. Tcl_PidCmd(dummy, interp, argc, argv)
  1363.     ClientData dummy;            /* Not used. */
  1364.     Tcl_Interp *interp;            /* Current interpreter. */
  1365.     int argc;                /* Number of arguments. */
  1366.     char **argv;            /* Argument strings. */
  1367. {
  1368.     FILE *f;
  1369.     OpenFile *oFilePtr;
  1370.     int i;
  1371.     char string[50];
  1372.  
  1373.     if (argc > 2) {
  1374.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1375.         argv[0], " ?fileId?\"", (char *) NULL);
  1376.     return TCL_ERROR;
  1377.     }
  1378.     if (argc == 1) {
  1379.     sprintf(interp->result, "%ld", (long) getpid());
  1380.     } else {
  1381.     if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
  1382.         return TCL_ERROR;
  1383.     }
  1384.     oFilePtr = tclOpenFiles[fileno(f)];
  1385.     for (i = 0; i < oFilePtr->numPids; i++) {
  1386.         sprintf(string, "%d", oFilePtr->pidPtr[i]);
  1387.         Tcl_AppendElement(interp, string);
  1388.     }
  1389.     }
  1390.     return TCL_OK;
  1391. }
  1392.  
  1393. /*
  1394.  *----------------------------------------------------------------------
  1395.  *
  1396.  * Tcl_PutsCmd --
  1397.  *
  1398.  *    This procedure is invoked to process the "puts" Tcl command.
  1399.  *    See the user documentation for details on what it does.
  1400.  *
  1401.  * Results:
  1402.  *    A standard Tcl result.
  1403.  *
  1404.  * Side effects:
  1405.  *    See the user documentation.
  1406.  *
  1407.  *----------------------------------------------------------------------
  1408.  */
  1409.  
  1410.     /* ARGSUSED */
  1411. int
  1412. Tcl_PutsCmd(dummy, interp, argc, argv)
  1413.     ClientData dummy;            /* Not used. */
  1414.     Tcl_Interp *interp;            /* Current interpreter. */
  1415.     int argc;                /* Number of arguments. */
  1416.     char **argv;            /* Argument strings. */
  1417. {
  1418.     FILE *f;
  1419.     int i, newline;
  1420.     char *fileId;
  1421.  
  1422.     i = 1;
  1423.     newline = 1;
  1424.     if ((argc >= 2) && (strcmp(argv[1], "-nonewline") == 0)) {
  1425.     newline = 0;
  1426.     i++;
  1427.     }
  1428.     if ((i < (argc-3)) || (i >= argc)) {
  1429.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1430.         " ?-nonewline? ?fileId? string\"", (char *) NULL);
  1431.     return TCL_ERROR;
  1432.     }
  1433.  
  1434.     /*
  1435.      * The code below provides backwards compatibility with an old
  1436.      * form of the command that is no longer recommended or documented.
  1437.      */
  1438.  
  1439.     if (i == (argc-3)) {
  1440.     if (strncmp(argv[i+2], "nonewline", strlen(argv[i+2])) != 0) {
  1441.         Tcl_AppendResult(interp, "bad argument \"", argv[i+2],
  1442.             "\": should be \"nonewline\"", (char *) NULL);
  1443.         return TCL_ERROR;
  1444.     }
  1445.     newline = 0;
  1446.     }
  1447.     if (i == (argc-1)) {
  1448.     fileId = "stdout";
  1449.     } else {
  1450.     fileId = argv[i];
  1451.     i++;
  1452.     }
  1453.  
  1454.     if (Tcl_GetOpenFile(interp, fileId, 1, 1, &f) != TCL_OK) {
  1455.     return TCL_ERROR;
  1456.     }
  1457.  
  1458.     clearerr(f);
  1459.     fputs(argv[i], f);
  1460.     if (newline) {
  1461.     fputc('\n', f);
  1462.     }
  1463.     if (ferror(f)) {
  1464.     Tcl_AppendResult(interp, "error writing \"", fileId,
  1465.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  1466.     return TCL_ERROR;
  1467.     }
  1468.     return TCL_OK;
  1469. }
  1470.  
  1471. /*
  1472.  *----------------------------------------------------------------------
  1473.  *
  1474.  * Tcl_PwdCmd --
  1475.  *
  1476.  *    This procedure is invoked to process the "pwd" Tcl command.
  1477.  *    See the user documentation for details on what it does.
  1478.  *
  1479.  * Results:
  1480.  *    A standard Tcl result.
  1481.  *
  1482.  * Side effects:
  1483.  *    See the user documentation.
  1484.  *
  1485.  *----------------------------------------------------------------------
  1486.  */
  1487.  
  1488.     /* ARGSUSED */
  1489. int
  1490. Tcl_PwdCmd(dummy, interp, argc, argv)
  1491.     ClientData dummy;            /* Not used. */
  1492.     Tcl_Interp *interp;            /* Current interpreter. */
  1493.     int argc;                /* Number of arguments. */
  1494.     char **argv;            /* Argument strings. */
  1495. {
  1496.     char buffer[MAXPATHLEN+1];
  1497.  
  1498.     if (argc != 1) {
  1499.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1500.         argv[0], "\"", (char *) NULL);
  1501.     return TCL_ERROR;
  1502.     }
  1503.     if (currentDir == NULL) {
  1504.     if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
  1505.         if (errno == ERANGE) {
  1506.         interp->result = "working directory name is too long";
  1507.         } else {
  1508.         Tcl_AppendResult(interp,
  1509.             "error getting working directory name: ",
  1510.             Tcl_PosixError(interp), (char *) NULL);
  1511.         }
  1512.         return TCL_ERROR;
  1513.     }
  1514.     currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
  1515.     strcpy(currentDir, buffer);
  1516.     }
  1517.     interp->result = currentDir;
  1518.     return TCL_OK;
  1519. }
  1520.  
  1521. /*
  1522.  *----------------------------------------------------------------------
  1523.  *
  1524.  * Tcl_ReadCmd --
  1525.  *
  1526.  *    This procedure is invoked to process the "read" Tcl command.
  1527.  *    See the user documentation for details on what it does.
  1528.  *
  1529.  * Results:
  1530.  *    A standard Tcl result.
  1531.  *
  1532.  * Side effects:
  1533.  *    See the user documentation.
  1534.  *
  1535.  *----------------------------------------------------------------------
  1536.  */
  1537.  
  1538.     /* ARGSUSED */
  1539. int
  1540. Tcl_ReadCmd(dummy, interp, argc, argv)
  1541.     ClientData dummy;            /* Not used. */
  1542.     Tcl_Interp *interp;            /* Current interpreter. */
  1543.     int argc;                /* Number of arguments. */
  1544.     char **argv;            /* Argument strings. */
  1545. {
  1546.     int bytesLeft, bytesRead, askedFor, got;
  1547. #define READ_BUF_SIZE 4096
  1548.     char buffer[READ_BUF_SIZE+1];
  1549.     int newline, i;
  1550.     FILE *f;
  1551.  
  1552.     if ((argc != 2) && (argc != 3)) {
  1553.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1554.         " fileId ?numBytes?\" or \"", argv[0],
  1555.         " ?-nonewline? fileId\"", (char *) NULL);
  1556.     return TCL_ERROR;
  1557.     }
  1558.     i = 1;
  1559.     newline = 1;
  1560.     if ((argc == 3) && (strcmp(argv[1], "-nonewline") == 0)) {
  1561.     newline = 0;
  1562.     i++;
  1563.     }
  1564.     if (Tcl_GetOpenFile(interp, argv[i], 0, 1, &f) != TCL_OK) {
  1565.     return TCL_ERROR;
  1566.     }
  1567.  
  1568.     /*
  1569.      * Compute how many bytes to read, and see whether the final
  1570.      * newline should be dropped.
  1571.      */
  1572.  
  1573.     if ((argc >= (i + 2)) && isdigit(UCHAR(argv[i+1][0]))) {
  1574.     if (Tcl_GetInt(interp, argv[i+1], &bytesLeft) != TCL_OK) {
  1575.         return TCL_ERROR;
  1576.     }
  1577.     } else {
  1578.     bytesLeft = INT_MAX;
  1579.  
  1580.     /*
  1581.      * The code below provides backward compatibility for an
  1582.      * archaic earlier version of this command.
  1583.      */
  1584.  
  1585.     if (argc >= (i + 2)) {
  1586.         if (strncmp(argv[i+1], "nonewline", strlen(argv[i+1])) == 0) {
  1587.         newline = 0;
  1588.         } else {
  1589.         Tcl_AppendResult(interp, "bad argument \"", argv[i+1],
  1590.             "\": should be \"nonewline\"", (char *) NULL);
  1591.         return TCL_ERROR;
  1592.         }
  1593.     }
  1594.     }
  1595.  
  1596.     /*
  1597.      * Read the file in one or more chunks.
  1598.      */
  1599.  
  1600.     bytesRead = 0;
  1601.     clearerr(f);
  1602.     while (bytesLeft > 0) {
  1603.     askedFor = READ_BUF_SIZE;
  1604.     if (bytesLeft < READ_BUF_SIZE) {
  1605.         askedFor = bytesLeft;
  1606.     }
  1607.     got = fread(buffer, 1, (size_t) askedFor, f);
  1608.     if (ferror(f)) {
  1609.         /*
  1610.          * If the file is in non-blocking mode, break out of the
  1611.          * loop and return any bytes that were read.
  1612.          */
  1613.  
  1614.         if (((errno == EWOULDBLOCK) || (errno == EAGAIN))
  1615.             && ((got > 0) || (bytesRead > 0))) {
  1616.         clearerr(f);
  1617.         bytesLeft = got;
  1618.         } else {
  1619.         Tcl_ResetResult(interp);
  1620.         Tcl_AppendResult(interp, "error reading \"", argv[i],
  1621.             "\": ", Tcl_PosixError(interp), (char *) NULL);
  1622.         return TCL_ERROR;
  1623.         }
  1624.     }
  1625.     if (got != 0) {
  1626.         buffer[got] = 0;
  1627.         Tcl_AppendResult(interp, buffer, (char *) NULL);
  1628.         bytesLeft -= got;
  1629.         bytesRead += got;
  1630.     }
  1631.     if (got < askedFor) {
  1632.         break;
  1633.     }
  1634.     }
  1635.     if ((newline == 0) && (bytesRead > 0)
  1636.         && (interp->result[bytesRead-1] == '\n')) {
  1637.     interp->result[bytesRead-1] = 0;
  1638.     }
  1639.     return TCL_OK;
  1640. }
  1641.  
  1642. /*
  1643.  *----------------------------------------------------------------------
  1644.  *
  1645.  * Tcl_SeekCmd --
  1646.  *
  1647.  *    This procedure is invoked to process the "seek" Tcl command.
  1648.  *    See the user documentation for details on what it does.
  1649.  *
  1650.  * Results:
  1651.  *    A standard Tcl result.
  1652.  *
  1653.  * Side effects:
  1654.  *    See the user documentation.
  1655.  *
  1656.  *----------------------------------------------------------------------
  1657.  */
  1658.  
  1659.     /* ARGSUSED */
  1660. int
  1661. Tcl_SeekCmd(notUsed, interp, argc, argv)
  1662.     ClientData notUsed;            /* Not used. */
  1663.     Tcl_Interp *interp;            /* Current interpreter. */
  1664.     int argc;                /* Number of arguments. */
  1665.     char **argv;            /* Argument strings. */
  1666. {
  1667.     FILE *f;
  1668.     int offset, mode;
  1669.  
  1670.     if ((argc != 3) && (argc != 4)) {
  1671.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1672.         " fileId offset ?origin?\"", (char *) NULL);
  1673.     return TCL_ERROR;
  1674.     }
  1675.     if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
  1676.     return TCL_ERROR;
  1677.     }
  1678.     if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) {
  1679.     return TCL_ERROR;
  1680.     }
  1681.     mode = SEEK_SET;
  1682.     if (argc == 4) {
  1683.     size_t length;
  1684.     int c;
  1685.  
  1686.     length = strlen(argv[3]);
  1687.     c = argv[3][0];
  1688.     if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) {
  1689.         mode = SEEK_SET;
  1690.     } else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) {
  1691.         mode = SEEK_CUR;
  1692.     } else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) {
  1693.         mode = SEEK_END;
  1694.     } else {
  1695.         Tcl_AppendResult(interp, "bad origin \"", argv[3],
  1696.             "\": should be start, current, or end", (char *) NULL);
  1697.         return TCL_ERROR;
  1698.     }
  1699.     }
  1700.     clearerr(f);
  1701.     if (fseek(f, (long) offset, mode) == -1) {
  1702.     Tcl_AppendResult(interp, "error during seek: ",
  1703.         Tcl_PosixError(interp), (char *) NULL);
  1704.     return TCL_ERROR;
  1705.     }
  1706.  
  1707.     return TCL_OK;
  1708. }
  1709.  
  1710. /*
  1711.  *----------------------------------------------------------------------
  1712.  *
  1713.  * Tcl_SourceCmd --
  1714.  *
  1715.  *    This procedure is invoked to process the "source" Tcl command.
  1716.  *    See the user documentation for details on what it does.
  1717.  *
  1718.  * Results:
  1719.  *    A standard Tcl result.
  1720.  *
  1721.  * Side effects:
  1722.  *    See the user documentation.
  1723.  *
  1724.  *----------------------------------------------------------------------
  1725.  */
  1726.  
  1727.     /* ARGSUSED */
  1728. int
  1729. Tcl_SourceCmd(dummy, interp, argc, argv)
  1730.     ClientData dummy;            /* Not used. */
  1731.     Tcl_Interp *interp;            /* Current interpreter. */
  1732.     int argc;                /* Number of arguments. */
  1733.     char **argv;            /* Argument strings. */
  1734. {
  1735.     if (argc != 2) {
  1736.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1737.         " fileName\"", (char *) NULL);
  1738.     return TCL_ERROR;
  1739.     }
  1740.     return Tcl_EvalFile(interp, argv[1]);
  1741. }
  1742.  
  1743. /*
  1744.  *----------------------------------------------------------------------
  1745.  *
  1746.  * Tcl_TellCmd --
  1747.  *
  1748.  *    This procedure is invoked to process the "tell" Tcl command.
  1749.  *    See the user documentation for details on what it does.
  1750.  *
  1751.  * Results:
  1752.  *    A standard Tcl result.
  1753.  *
  1754.  * Side effects:
  1755.  *    See the user documentation.
  1756.  *
  1757.  *----------------------------------------------------------------------
  1758.  */
  1759.  
  1760.     /* ARGSUSED */
  1761. int
  1762. Tcl_TellCmd(notUsed, interp, argc, argv)
  1763.     ClientData notUsed;            /* Not used. */
  1764.     Tcl_Interp *interp;            /* Current interpreter. */
  1765.     int argc;                /* Number of arguments. */
  1766.     char **argv;            /* Argument strings. */
  1767. {
  1768.     FILE *f;
  1769.  
  1770.     if (argc != 2) {
  1771.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1772.         " fileId\"", (char *) NULL);
  1773.     return TCL_ERROR;
  1774.     }
  1775.     if (Tcl_GetOpenFile(interp, argv[1], 0, 0, &f) != TCL_OK) {
  1776.     return TCL_ERROR;
  1777.     }
  1778.     sprintf(interp->result, "%ld", (long int) ftell(f));
  1779.     return TCL_OK;
  1780. }
  1781.  
  1782. /*
  1783.  *----------------------------------------------------------------------
  1784.  *
  1785.  * Tcl_TimeCmd --
  1786.  *
  1787.  *    This procedure is invoked to process the "time" Tcl command.
  1788.  *    See the user documentation for details on what it does.
  1789.  *
  1790.  * Results:
  1791.  *    A standard Tcl result.
  1792.  *
  1793.  * Side effects:
  1794.  *    See the user documentation.
  1795.  *
  1796.  *----------------------------------------------------------------------
  1797.  */
  1798.  
  1799.     /* ARGSUSED */
  1800. int
  1801. Tcl_TimeCmd(dummy, interp, argc, argv)
  1802.     ClientData dummy;            /* Not used. */
  1803.     Tcl_Interp *interp;            /* Current interpreter. */
  1804.     int argc;                /* Number of arguments. */
  1805.     char **argv;            /* Argument strings. */
  1806. {
  1807.     int count, i, result;
  1808.     double timePer;
  1809. #if NO_GETTOD
  1810.     struct tms dummy2;
  1811.     long start, stop;
  1812. #else
  1813.     struct timeval start, stop;
  1814.     struct timezone tz;
  1815.     int micros;
  1816. #endif
  1817.  
  1818.     if (argc == 2) {
  1819.     count = 1;
  1820.     } else if (argc == 3) {
  1821.     if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
  1822.         return TCL_ERROR;
  1823.     }
  1824.     } else {
  1825.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  1826.         " command ?count?\"", (char *) NULL);
  1827.     return TCL_ERROR;
  1828.     }
  1829. #if NO_GETTOD
  1830.     start = times(&dummy2);
  1831. #else
  1832.     gettimeofday(&start, &tz);
  1833. #endif
  1834.     for (i = count ; i > 0; i--) {
  1835.     result = Tcl_Eval(interp, argv[1]);
  1836.     if (result != TCL_OK) {
  1837.         if (result == TCL_ERROR) {
  1838.         char msg[60];
  1839.         sprintf(msg, "\n    (\"time\" body line %d)",
  1840.             interp->errorLine);
  1841.         Tcl_AddErrorInfo(interp, msg);
  1842.         }
  1843.         return result;
  1844.     }
  1845.     }
  1846. #if NO_GETTOD
  1847.     stop = times(&dummy2);
  1848.     timePer = (((double) (stop - start))*1000000.0)/CLK_TCK;
  1849. #else
  1850.     gettimeofday(&stop, &tz);
  1851.     micros = (stop.tv_sec - start.tv_sec)*1000000
  1852.         + (stop.tv_usec - start.tv_usec);
  1853.     timePer = micros;
  1854. #endif
  1855.     Tcl_ResetResult(interp);
  1856.     sprintf(interp->result, "%.0f microseconds per iteration",
  1857.     (count <= 0) ? 0 : timePer/count);
  1858.     return TCL_OK;
  1859. }
  1860.  
  1861. /*
  1862.  *----------------------------------------------------------------------
  1863.  *
  1864.  * CleanupChildren --
  1865.  *
  1866.  *    This is a utility procedure used to wait for child processes
  1867.  *    to exit, record information about abnormal exits, and then
  1868.  *    collect any stderr output generated by them.
  1869.  *
  1870.  * Results:
  1871.  *    The return value is a standard Tcl result.  If anything at
  1872.  *    weird happened with the child processes, TCL_ERROR is returned
  1873.  *    and a message is left in interp->result.
  1874.  *
  1875.  * Side effects:
  1876.  *    If the last character of interp->result is a newline, then it
  1877.  *    is removed unless keepNewline is non-zero.  File errorId gets
  1878.  *    closed, and pidPtr is freed back to the storage allocator.
  1879.  *
  1880.  *----------------------------------------------------------------------
  1881.  */
  1882.  
  1883. static int
  1884. CleanupChildren(interp, numPids, pidPtr, errorId, keepNewline)
  1885.     Tcl_Interp *interp;        /* Used for error messages. */
  1886.     int numPids;        /* Number of entries in pidPtr array. */
  1887.     int *pidPtr;        /* Array of process ids of children. */
  1888.     int errorId;        /* File descriptor index for file containing
  1889.                  * stderr output from pipeline.  -1 means
  1890.                  * there isn't any stderr output. */
  1891.     int keepNewline;        /* Non-zero means don't discard trailing
  1892.                  * newline. */
  1893. {
  1894.     int result = TCL_OK;
  1895.     int i, pid, length, abnormalExit;
  1896.     WAIT_STATUS_TYPE waitStatus;
  1897.     char *msg;
  1898.  
  1899.     abnormalExit = 0;
  1900.     for (i = 0; i < numPids; i++) {
  1901.     pid = waitpid(pidPtr[i], (int *) &waitStatus, 0);
  1902.     if (pid == -1) {
  1903.         msg = Tcl_PosixError(interp);
  1904.         if (errno == ECHILD) {
  1905.         /*
  1906.          * This changeup in message suggested by Mark Diekhans
  1907.          * to remind people that ECHILD errors can occur on
  1908.          * some systems if SIGCHLD isn't in its default state.
  1909.          */
  1910.  
  1911.         msg = "child process lost (is SIGCHLD ignored or trapped?)";
  1912.         }
  1913.         Tcl_AppendResult(interp, "error waiting for process to exit: ",
  1914.             msg, (char *) NULL);
  1915.         continue;
  1916.     }
  1917.  
  1918.     /*
  1919.      * Create error messages for unusual process exits.  An
  1920.      * extra newline gets appended to each error message, but
  1921.      * it gets removed below (in the same fashion that an
  1922.      * extra newline in the command's output is removed).
  1923.      */
  1924.  
  1925.     if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
  1926.         char msg1[20], msg2[20];
  1927.  
  1928.         result = TCL_ERROR;
  1929.         sprintf(msg1, "%d", pid);
  1930.         if (WIFEXITED(waitStatus)) {
  1931.         sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
  1932.         Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
  1933.             (char *) NULL);
  1934.         abnormalExit = 1;
  1935.         } else if (WIFSIGNALED(waitStatus)) {
  1936.         char *p;
  1937.     
  1938.         p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
  1939.         Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
  1940.             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
  1941.             (char *) NULL);
  1942.         Tcl_AppendResult(interp, "child killed: ", p, "\n",
  1943.             (char *) NULL);
  1944.         } else if (WIFSTOPPED(waitStatus)) {
  1945.         char *p;
  1946.  
  1947.         p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
  1948.         Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
  1949.             Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p, (char *) NULL);
  1950.         Tcl_AppendResult(interp, "child suspended: ", p, "\n",
  1951.             (char *) NULL);
  1952.         } else {
  1953.         Tcl_AppendResult(interp,
  1954.             "child wait status didn't make sense\n",
  1955.             (char *) NULL);
  1956.         }
  1957.     }
  1958.     }
  1959.     ckfree((char *) pidPtr);
  1960.  
  1961.     /*
  1962.      * Read the standard error file.  If there's anything there,
  1963.      * then return an error and add the file's contents to the result
  1964.      * string.
  1965.      */
  1966.  
  1967.     if (errorId >= 0) {
  1968.     while (1) {
  1969. #        define BUFFER_SIZE 1000
  1970.         char buffer[BUFFER_SIZE+1];
  1971.         int count;
  1972.     
  1973.         count = read(errorId, buffer, (size_t) BUFFER_SIZE);
  1974.     
  1975.         if (count == 0) {
  1976.         break;
  1977.         }
  1978.         result = TCL_ERROR;
  1979.         if (count < 0) {
  1980.         Tcl_AppendResult(interp,
  1981.             "error reading stderr output file: ",
  1982.             Tcl_PosixError(interp), (char *) NULL);
  1983.         break;
  1984.         }
  1985.         buffer[count] = 0;
  1986.         Tcl_AppendResult(interp, buffer, (char *) NULL);
  1987.     }
  1988.     close(errorId);
  1989.     }
  1990.  
  1991.     /*
  1992.      * If a child exited abnormally but didn't output any error information
  1993.      * at all, generate an error message here.
  1994.      */
  1995.  
  1996.     if (abnormalExit && (*interp->result == 0)) {
  1997.     Tcl_AppendResult(interp, "child process exited abnormally",
  1998.         (char *) NULL);
  1999.     }
  2000.  
  2001.     /*
  2002.      * If the last character of interp->result is a newline, then remove
  2003.      * the newline character (the newline would just confuse things).
  2004.      * Special hack: must replace the old terminating null character
  2005.      * as a signal to Tcl_AppendResult et al. that we've mucked with
  2006.      * the string.
  2007.      */
  2008.  
  2009.     length = strlen(interp->result);
  2010.     if (!keepNewline && (length > 0) && (interp->result[length-1] == '\n')) {
  2011.     interp->result[length-1] = '\0';
  2012.     interp->result[length] = 'x';
  2013.     }
  2014.  
  2015.     return result;
  2016. }
  2017.